home *** CD-ROM | disk | FTP | other *** search
/ Aminet 33 / Aminet 33 - October 1999.iso / Aminet / dev / asm / Tandem.lha / Tandem / Teaching / 32.asm < prev    next >
Encoding:
Assembly Source File  |  1999-08-21  |  2.6 KB  |  75 lines
  1. * 32.asm    TLgetfont and TLnewfont     version 0.01   8.6.99
  2.  
  3.  
  4.  include 'Front.i'        ;*** change to 'Tandem.i' to step thru TL's ***
  5.  
  6.  
  7. ; This program introduces the selection of fonts. There are 5 subrountines
  8. ; for this. they use a table of fonts which is pointed to by xxp_FSuite.
  9. ; There can be 10 fonts, numbered 0-9, and each of these can have 4 forms,
  10. ; theoretically, 40 fonts in all. The window(s) can each have a font &
  11. ; font style attached. Or, they can have Topaz/8 attached, i.e. font 0,
  12. ; as they do initially.
  13.  
  14. ; Font 0 is always Topaz/8. So, you can use fonts 1-9. If you use TLgetfont
  15. ; or TLaslfont on any font already opened, it will be closed, and any
  16. ; windows using it will revert to font 0, i.e. Topaz/8.
  17.  
  18. ; Here are the subroutines:
  19. ;
  20. ; TLGetfont:  puts a predetermined fontname and height in an FSuite entry,
  21. ;             and closes anything already there. Does not open the font.
  22. ; TLAslfont:  as TLGetfont, but puts up a requester for the font.
  23. ; TLNewfont:  attaches an xxp_FSuite font & style to the xxp_ window.
  24. ; TLFsub:     closes an Fsuite font (called automatically by TLWclose)
  25.  
  26. ; The commonest font styles are:
  27. ;   0 plain
  28. ;   1 bold
  29. ;   2 italic
  30. ;   3 bold+italic
  31.  
  32.  
  33. strings: dc.b 0
  34. st_1: dc.b 'Demonstrate TLGetfont and TLNewfont',0 ;1
  35. st_2: dc.b 'Times.font',0 ;2
  36.  dc.b 'This is in Font 0..',0 ;3
  37.  dc.b 'But this is in Font 1!!',0 ;4
  38.  dc.b 'Oh - back to Font 0. Life goes on.',0 ;5
  39.  dc.b 'Perhaps it shouldn''t. So, click my close gadget.',0 ;6
  40.  
  41.  ds.w 0
  42.  
  43.  
  44. * Demonstrate fonts
  45. Program:
  46.  TLwindow0
  47.  beq.s Pr_quit
  48.  bsr Test                  ;do test of Getfont,&c
  49. Pr_quit:
  50.  rts
  51.  
  52. * test Getfont, &c
  53. Test:
  54.  TLgetfont #st_2,#1,#24    ;name=Times.font, FSuite number=1, height=24
  55.  TLstring #3,#10,#15       ;print string 3 at (10,15) in font 0 (Topaz/8)
  56.  TLnewfont #1,#0,#0        ;attach font 1 (Times/24), style 0 (plain)
  57.  beq Te_quit        ;go if bad (can only happen on 1st call of a font)
  58.  
  59.  TLstring #4,#10,#25       ;print string 4 at (10,25) in times/24 plain
  60.  TLnewfont #0,#0,#0        ;back to font 0 for window
  61.  TLstring #5,#10,#50       ;print string 5 at (10,50) in prefs font
  62.  move.l xxp_AcWind(a4),a5  ;point a5 to active window (i.e. window 0)
  63.  move.b #2,xxp_FrontPen(a5) ;use colour 2 for variety (default colour 1)
  64.  move.w #4,xxp_Tspc(a5)    ;and spread out text spacing (default spacing 0)
  65.  TLstring #6,#10,#60       ;print string 6 at (10,60) in prefs font
  66.  
  67. Te_wait:
  68.  TLkeyboard                ;wait for response
  69.  cmp.b #$93,d0             ;re-try if not close window
  70.  bne Te_wait
  71.  
  72. Te_quit:
  73.  rts                       ;note that Front0.i closes all fonts & windows
  74.  
  75.